Your Choice 3/Your Choice Software Collection 3.iso/prgmming/swag05/network.swg

Text File | 1994-09-22 | 112KB | 1 lines

SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00003                                                                           1      05-25-9408:22ALL                      JIM ROBB                 Re: Get Server Date      SWAG9405            14     ,î   {π MP> Can someone show me what a PASCAL procedure would look like toπ MP> encapsulate the following information (from Brown's int list):π MP> INT 21 - Novell NetWare - FILE SERVER - GET FILE SERVER DATE AND TIMEππI tested this on our Novell 3.11 network:π}ππprogram ServDate;ππuses Dos;ππtypeπ  tDateAndTime = recordπ    Year      : Byte;π    Month     : Byte;π    Day       : Byte;π    Hours     : Byte;π    Minutes   : Byte;π    Seconds   : Byte;π    DayOfWeek : Byteπ  end;ππ  String9 = string[ 9 ];ππconstπ  DayArray : array[ 0..6 ] of String9 =π             ( 'Sunday', 'Monday', 'Tuesday', 'Wednesday',π               'Thursday', 'Friday', 'Saturday' );ππ  MonthArray : array[ 1..12 ] of String9 =π               ( 'January', 'February', 'March', 'April', 'May', 'June',π                 'July', 'August', 'September', 'October', 'November',π                 'December' );πππfunction GetFileServerDateAndTime( var DTBuf : tDateAndTime ) : Byte;ππvar NovRegs : Registers;ππbeginπ  with NovRegs doπ  beginπ    AH := $E7;π    DS := Seg( DTBuf );π    DX := Ofs( DTBuf );π    MSDos( NovRegs );π    GetFileServerDateAndTime := ALπ  endπend;ππvarπ  DateAndTime : tDateAndTime;π  ResultCode  : Byte;ππbeginπ  ResultCode := GetFileServerDateAndTime( DateAndTime );π  if ResultCode = 0 thenπ    with DateAndTime doπ    beginπ      Write( 'File server date/time = ', DayArray[ DayOfWeek ], ', ',π             MonthArray[ Month ], ' ', Day );π      if ( Year < 80 ) thenπ        Write( ', 20', Year )π      elseπ        Write( ', 19', Year );π      WriteLn( ' at ', Hours, ':', Minutes, ':', Seconds )π    endπ  elseπ    WriteLn( 'Date/time call unsuccessful' )πend.π  2      05-26-9406:20ALL                      MARK BRAMWELL            NOVELL Library           SWAG9405            463    ,î   πUNIT Novell;π{---------------------------------------------------------------------------}π{                                                                           }π{  This UNIT provides a method of obtaining Novell information from a user  }π{  written program.  This UNIT was tested on an IBM AT running DOS 5.0 &    }π{  using Netware 2.15.  The unit compiled cleanly under Turbo Pascal 6.0    }π{                                                                           }π{  The UNIT has been updated to compile and run under Turbo Pascal for      }π{  Windows.                                                                 }π{                                                                           }π{  *** Tested ok with Netware 386 3.11  Sept/91                             }π{                                                                           }π{  Last Update:   11 Dec 91                                                 }π{                                                                           }π{---------------------------------------------------------------------------}π{                                                                           }π{  Any questions can be directed to:                                        }π{                                                                           }π{  Mark Bramwell                                                            }π{  University of Western Ontario                                            }π{  London, Ontario, N6A 3K7                                                 }π{                                                                           }π{  Phone:  [phone] [work]              519-473-3618 [home]             }π{                                                                           }π{  Bitnet: [e-mail]     Packet: ve3pzr @ ve3gyq         }π{                                                                           }π{  Anonymous FTP Server Internet Address: 129.100.22.100                    }π{                                                                           }π{---------------------------------------------------------------------------}ππ{ Any other Novell UNITS gladly accepted. }πππ{πmods February 1 1991, Ross Lazarus ([e-mail])π     var retcodes in procedure getservername, get_broadcast_message,π     verify_object_password comments, password conversion to upper case,ππSeems to work fine on a Netware 3.00 and on 3.01 servers -π}πππINTERFACEππ{$IFDEF WINDOWS}πUses WinDos;π{$ENDIF WINDOWS}ππ{$IFNDEF WINDOWS}πUses Dos;π{$ENDIF WINDOWS}ππConstπ  Months : Array [1..12] of String[3] = ('JAN','FEB','MAR','APR','MAY','JUN',π                                         'JUL','AUG','SEP','OCT','NOV','DEC');ππ  HEXDIGITS : Array [0..15] of char = '0123456789ABCDEF';ππType    byte4 = array [1..4] of byte;ππ        byte6 = array [1..6] of byte;ππVARππ{----------------------------------------------------------------------}π{  The following values can be pulled from an user written application }π{                                                                      }π{  The programmer would first call   GetServerInfo.                    }π{  Then he could   writeln(serverinfo.name)   to print the server name }π{----------------------------------------------------------------------}ππ      ServerInfo    : Recordπ                     ReturnLength    : Integer;π                     Server          : Packed Array [1..48] of Byte;π                     NetwareVers     : Byte;π                     NetwareSubV     : Byte;π                     ConnectionMax   : array [1..2] of byte;π                     ConnectionUse   : array [1..2] of byte;π                     MaxConVol       : array [1..2] of byte; {}π                     OS_revision     : byte;π                     SFT_level       : byte;π                     TTS_level       : byte;π                     peak_used       : array [1..2] of byte;π                  accounting_version : byte;π                     vap_version     : byte;π                     queuing_version : byte;π                print_server_version : byte;π             virtual_console_version : byte;π       security_restrictions_version : byte;π        Internetwork_version_version : byte;π                        Undefined    : Packed Array [1..60] of Byte;π               peak_connections_used : integer;π                     Connections_max : integer;π                  Connections_in_use : integer;π               Max_connected_volumes : integer;π                                name : string;π                   End;πππprocedure get_server_lan_driver_information(var _lan_board_number : integer;π{ This will return info on what }           var _text1,_text2:string;π{ type of network cards are being }         var _network_address : byte4;π{ used in the server. }                     var _host_address : byte6;π                                            var _driver_installed,π                                                _option_number,π                                                _retcode : integer);ππprocedure GetConnectionInfo(var LogicalStationNo: integer;π                            var name,hex_id:string;π                            var conntype:integer;π                            var datetime:string;π                            var retcode:integer);π{ returns username and login date/time when you supply the station number. }ππprocedure clear_connection(connection_number : integer; var retcode :πinteger);π{ kicks the workstation off the server}ππprocedure GetHexID(var userid,hexid: string;π                   var retcode: integer);π{ returns the novell hexid of an username when you supply the username. }ππprocedure GetServerInfo;π{ returns various info of the default server }ππprocedure GetUser( var _station: integer;π                   var _username: string;π                   var retcode:integer);π{ returns logged-in station username when you supply the station number. }ππprocedure GetNode( var hex_addr: string;π                   var retcode: integer);π{ returns your physical network node in hex. }ππprocedure GetStation( var _station: integer;π                      var retcode: integer);π{ returns the station number of your workstation }ππprocedure GetServerName(var servername : string;π                        var retcode : integer);ππ{ returns the name of the current server }ππprocedure Send_Message_to_Username(username,message : string;π                                   var retcode: integer);π{ Sends a novell message to the userid's workstation }ππprocedure Send_Message_to_Station(station:integer;π                                  message : string;π                                  var retcode: integer);π{ Sends a message to the workstation station # }ππprocedure Get_Volume_Name(var volume_name: string;π                          volume_number: integer;π                          var retcode:integer);π{ Gets the Volume name from Novell network drive }π{ Example:  SYS    Note: default drive must be a }π{ network drive.                                 }ππprocedure get_realname(var userid:string;π                       var realname:string;π                       var retcode:integer);π{ You supply the userid, and it returns the realname as stored by syscon. }π{ Example:  userid=mbramwel   realname=Mark Bramwell }ππprocedure get_broadcast_mode(var bmode:integer);ππprocedure set_broadcast_mode(bmode:integer);ππprocedure get_broadcast_message(var bmessage: string;π                                var retcode : integer);ππprocedure get_server_datetime(var _year,_month,_day,_hour,_min,_sec,_dow:integer);π{ pulls from the server the date, time and Day Of Week }ππprocedure set_date_from_server;π{ pulls the date from the server and updates the workstation's clock }ππprocedure set_time_from_server;π{ pulls the time from the server and updates the workstation's clock }ππprocedure get_server_version(var _version : string);ππprocedure open_message_pipe(var _connection, retcode : integer);ππprocedure close_message_pipe(var _connection, retcode : integer);ππprocedure check_message_pipe(var _connection, retcode : integer);ππprocedure send_personal_message(var _connection : integer; var _message :πstring; var retcode : integer);ππprocedure get_personal_message(var _connection : integer; var _message :πstring; var retcode : integer);ππprocedure get_drive_connection_id(var drive_number,π                                  server_number : integer);π{pass the drive number - it returns the server number if a network volume}ππprocedure get_file_server_name(var server_number : integer;π                               var server_name : string);ππprocedure get_directory_path(var handle : integer;π                             var pathname : string;π                             var retcode : integer);ππprocedure get_drive_handle_id(var drive_number, handle_number : integer);ππprocedure set_preferred_connection_id(server_num : integer);ππprocedure get_preferred_connection_id(var server_num : integer);ππprocedure set_primary_connection_id(server_num : integer);ππprocedure get_primary_connection_id(var server_num : integer);ππprocedure get_default_connection_id(var server_num : integer);ππprocedure Get_Internet_Address(station : integer;π                               var net_number, node_addr, socket_number :πstring;π                               var retcode : integer);ππprocedure login_to_file_server(obj_type:integer; _name,_password : string;varπretcode:integer);ππprocedure logout;ππprocedure logout_from_file_server(var id: integer);ππprocedure down_file_server(flag:integer;var retcode : integer);ππprocedure detach_from_file_server(var id,retcode:integer);ππprocedure disable_file_server_login(var retcode : integer);ππprocedure enable_file_server_login(var retcode : integer);ππprocedure alloc_permanent_directory_handle(var _dir_handle : integer;π                                           var _drive_letter : string;π                                           var _dir_path_name : string;π                                           var _new_dir_handle : integer;π                                           var _effective_rights: byte;π                                           var _retcode : integer);ππprocedure map(var drive_spec:string;π              var _rights:byte;π              var _retcode : integer);ππprocedure scan_object(var last_object: longint;π                      var search_object_type: integer;π                      var search_object : string;π                      var replyid : longint;π                      var replytype : integer; var replyname : string;π                      var replyflag : integer; var replysecurity : byte;π                      var replyproperties : integer; var retcode : integer);ππprocedure verify_object_password(var object_type:integer; varπobject_name,password : string; var retcode : integer);ππ{--------------------------------------------------------------------------}π{ file locking routines }π{-----------------------}ππprocedure log_file(lock_directive:integer; log_filename: string;πlog_timeout:integer; var retcode:integer);ππprocedure clear_file_set;ππprocedure lock_file_set(lock_timeout:integer; var retcode:integer);ππprocedure release_file_set;ππprocedure release_file(log_filename: string; var retcode:integer);ππprocedure clear_file(log_filename: string; var retcode:integer);ππ{--------------------------------------------------------------------------π---}ππprocedure open_semaphore( _name:string;π                          _initial_value:shortint;π                          var _open_count:integer;π                          var _handle:longint;π                          var retcode:integer);ππprocedure close_semaphore(var _handle:longint; var retcode:integer);ππprocedure examine_semaphore(var _handle:longint; var _value:shortint; varπ_count, retcode:integer);ππprocedure signal_semaphore(var _handle:longint; var retcode:integer);ππprocedure wait_on_semaphore(var _handle:longint; _timeout:integer; varπretcode:integer);ππprocedure purge_all_erased_files(var retcode:integer);ππprocedure purge_erased_files(var retcode:integer);π{--------------------------------------------------------------------------π---}πππIMPLEMENTATIONππconstπ     zero = '0';ππvarπ   retcode : byte; { return code for all functions }ππ{$IFDEF WINDOWS}π  regs : TRegisters;   { Turbo Pascal for Windows }π{$ENDIF WINDOWS}ππ{$IFNDEF WINDOWS}π  regs : registers;    { Turbo Pascal for Dos }π{$ENDIF WINDOWS}ππprocedure get_volume_name(var volume_name: string; volume_number: integer;π                          var retcode:integer);π{πpulls volume names from default server.  Use set_preferred_connection_id toπset the default server.πretcodes:  0=ok, 1=no volume assigned  98h= # out of rangeπ}ππVARπ   count,count1  : integer;ππ   requestbuffer : recordπ      len        : integer;π      func       : byte;π      vol_num    : byte;π      end;ππ    replybuffer  : recordπ      len        : integer;π      vol_length : byte;π      name       : packed array [1..16] of byte;π      end;ππbeginπWith Regs doπbeginπ  ah := $E2;π  ds := seg(requestbuffer);π  si := ofs(requestbuffer);π  es := seg(replybuffer);π  di := ofs(replybuffer);π end;π With requestbuffer doπ beginπ  len  := 2;π  func := 6;π  vol_num := volume_number;  {passed from calling program}π end;π With replybuffer doπ beginπ  len :=  17;π  vol_length := 0;π  for count := 1 to 16 do name[count] := $00;π end;π msdos(Regs);π volume_name := '';π if replybuffer.vol_length > 0 thenπ    for count := 1 to replybuffer.vol_length doπ        volume_name := volume_name + chr(replybuffer.name[count]);π retcode := Regs.al;πend;ππprocedure verify_object_password(var object_type:integer; varπobject_name,password : string; var retcode : integer);π{πfor netware 3.xx remember to have previously (eg in the autoexec file )πset allow unencrypted passwords = onπon the console, otherwise this call always fails !πNote that intruder lockout status is affected by this call !πNetware security isn't that stupid....πPasswords appear to need to be converted to upper caseππretcode      apparent meaning as far as I can work out....ππ0            verification of object_name/password combinationπ197          account disabled due to intrusion lockoutπ214          unencrypted password calls not allowed on this v3+ serverπ252          no such object_name on this serverπ255          failure to verify object_name/password combinationππ}πvar  request_buffer : recordπ      buffer_length : integer;π        subfunction : byte;π           obj_type : array [1..2] of byte;π    obj_name_length : byte;π           obj_name : array [1..47] of byte;π    password_length : byte;π       obj_password : array [1..127] of byte;π                end;ππ       reply_buffer : recordπ      buffer_length : integer;π                end;ππ              count : integer;ππbeginπ     With request_buffer doπ     beginπ          buffer_length := 179;π          subfunction := $3F;π          obj_type[1] := 0;π          obj_type[2] := object_type;π          obj_name_length := 47;π          for count := 1 to 47 doπ              obj_name[count] := $00;π          for count := 1 to length(object_name) doπ          obj_name[count] := ord(object_name[count]);π          password_length := length(password);π          for count := 1 to 127 doπ              obj_password[count] := $00;π          if password_length > 0 thenπ             for count := 1 to password_length doπ                 obj_password[count] := ord(upcase(password[count]));π       end;π       With reply_buffer doπ            buffer_length := 0;π       With regs doπ       beginπ            Ah := $E3;π            Ds := Seg(Request_Buffer);π            Si := Ofs(Request_Buffer);π            Es := Seg(Reply_Buffer);π            Di := Ofs(Reply_Buffer);π       End;π       msdos(regs);π       retcode := regs.al;πend; { verify_object_password }ππππprocedure scan_object(var last_object: longint; var search_object_type:πinteger;π                      var search_object : string; var replyid : longint;π                      var replytype : integer; var replyname : string;π                      var replyflag : integer; var replysecurity : byte;π                      var replyproperties : integer; var retcode : integer);πvarπ    request_buffer : recordπ     buffer_length : integer;π       subfunction : byte;π         last_seen : longint;π       search_type : array [1..2] of byte;π       name_length : byte;π       search_name : array [1..47] of byte;π               end;ππ      reply_buffer : recordπ     buffer_length : integer;π         object_id : longint;π       object_type : array [1..2] of byte;π       object_name : array [1..48] of byte;π       object_flag : byte;π          security : byte;π        properties : byte;π               end;ππ             count : integer;ππbeginπwith request_buffer doπbeginπ buffer_length := 55;π subfunction := $37;π last_seen := last_object;π if search_object_type = -1 then { -1 = wildcard }π   beginπ   search_type[1] := $ff;π   search_type[2] := $ff;π   end elseπ   beginπ   search_type[1] := 0;π   search_type[2] := search_object_type;π   end;πname_length := length(search_object);πfor count := 1 to 47 do search_name[count] := $00;πif name_length > 0 then for count := 1 to name_length doπ   search_name[count] := ord(upcase(search_object[count]));πend;πWith reply_buffer doπbeginπ buffer_length := 57;π object_id:= 0;π object_type[1] := 0;π object_type[2] := 0;π for count := 1 to 48 do object_name[count] := $00;π object_flag := 0;π security := 0;π properties := 0;πend;πWith Regs Do Beginπ Ah := $E3;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);πEnd;πmsdos(regs);πretcode := regs.al;πWith reply_buffer doπbeginπ replyflag := object_flag;π replyproperties := properties;π replysecurity := security;π replytype := object_type[2];π replyid := object_id;πend;πcount := 1;πreplyname := '';πWhile (count <= 48)  and (reply_buffer.Object_Name[count] <> 0) Do Beginπ    replyName := replyname + Chr(reply_buffer.Object_name[count]);π    count := count + 1;π    End { while };πend;πππprocedure alloc_permanent_directory_handleπ  (var _dir_handle : integer; var _drive_letter : string;π   var _dir_path_name : string; var _new_dir_handle : integer;π   var _effective_rights: byte; var _retcode : integer);ππvar request_buffer : recordπ     buffer_length : integer;π       subfunction : byte;π        dir_handle : byte;π      drive_letter : byte;π   dir_path_length : byte;π     dir_path_name : packed array [1..255] of byte;π               end;ππ      reply_buffer : recordπ     buffer_length : integer;π    new_dir_handle : byte;π  effective_rights : byte;π               end;ππ  count : integer;ππbeginπWith request_buffer doπbeginπ buffer_length := 259;π subfunction := $12;π dir_handle := _dir_handle;π drive_letter := ord(upcase(_drive_letter[1]));π dir_path_length := length(_dir_path_name);π for count := 1 to 255 do dir_path_name[count] := $0;π if dir_path_length > 0 then for count := 1 to dir_path_length doπ    dir_path_name[count] := ord(upcase(_dir_path_name[count]));πend;πWith reply_buffer doπbeginπ buffer_length := 2;π new_dir_handle := 0;π effective_rights := 0;πend;πWith Regs Do Beginπ Ah := $E2;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);πEnd;πmsdos(regs);π_retcode := regs.al;π_effective_rights := $0;π_new_dir_handle := $0;πif _retcode = 0 thenπbeginπ _effective_rights := reply_buffer.effective_rights;π _new_dir_handle := reply_buffer.new_dir_handle;πend;πend;ππprocedure map(var drive_spec:string; var _rights:byte; var _retcode :πinteger);πvarπ    dir_handle : integer;π     path_name : string;π        rights : byte;π  drive_number : integer;π  drive_letter : string;π    new_handle : integer;π       retcode : integer;ππbeginπ {first thing is we strip leading and trailing blanks}π while drive_spec[1]=' ' do  drive_spec :=πcopy(drive_spec,2,length(drive_spec));π while drive_spec[length(drive_spec)]=' ' do  drive_spec :=πcopy(drive_spec,1,length(drive_spec)-1);π drive_number := ord(upcase(drive_spec[1]))-65;π drive_letter := upcase(drive_spec[1]);π path_name := copy(drive_spec,4,length(drive_spec));π get_drive_handle_id(drive_number,dir_handle);π alloc_permanent_directory_handle(dir_handle,drive_letter,path_name,new_handle,π rights,retcode);π _retcode := retcode;π _rights := rights;πend;πππππprocedure down_file_server(flag:integer;var retcode : integer);πvarππrequest_buffer : recordπ buffer_length : integer;π   subfunction : byte;π     down_flag : byte;π           end;ππ  reply_buffer : recordπ buffer_length : integer;π           end;ππbeginπWith request_buffer doπbeginπ buffer_length := 2;π subfunction := $D3;π down_flag := flag;πend;πreply_buffer.buffer_length := 0;πWith Regs Do Beginπ Ah := $E3;π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(Reply_Buffer);π Di := Ofs(Reply_Buffer);πEnd;πmsdos(regs);πretcode := regs.al;πend;πππprocedure set_preferred_connection_id(server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $00;π regs.ds := 0;π regs.es := 0;π regs.dl := server_num;π msdos(regs);πend;ππprocedure set_primary_connection_id(server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $04;π regs.ds := 0;π regs.es := 0;π regs.dl := server_num;π msdos(regs);πend;ππprocedure get_primary_connection_id(var server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $05;π regs.es := 0;π regs.ds := 0;π msdos(regs);π server_num := regs.al;πend;ππprocedure get_default_connection_id(var server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $02;π regs.es := 0;π regs.ds := 0;π msdos(regs);π server_num := regs.al;πend;ππprocedure get_preferred_connection_id(var server_num : integer);πbeginπ regs.ah := $F0;π regs.al := $02;π regs.ds := 0;π regs.es := 0;π msdos(regs);π server_num := regs.al;πend;πππprocedure get_drive_connection_id(var drive_number, server_number : integer);πvarππ drive_table : array [1..32] of byte;π       count : integer;π           p : ^byte;ππbeginπ  regs.ah := $EF;π  regs.al := $02;π  regs.es := 0;π  regs.ds := 0;π  msdos(regs);π  p := ptr(regs.es, regs.si);π  move(p^,drive_table,32);π  if ((drive_number < 0) or (drive_number > 32))  then drive_number := 1;π  server_number := drive_table[drive_number];πend;ππprocedure get_drive_handle_id(var drive_number, handle_number : integer);πvarπ drive_table : array [1..32] of byte;π       count : integer;π           p : ^byte;ππbeginπ  regs.ah := $EF;π  regs.al := $00;π  regs.ds := 0;π  regs.es := 0;π  msdos(regs);π  p := ptr(regs.es, regs.si);π  move(p^,drive_table,32);π  if ((drive_number < 0) or (drive_number > 32))  then drive_number := 1;π  handle_number := drive_table[drive_number];πend;πππprocedure get_file_server_name(var server_number : integer; var server_name :πstring);πvarπ  name_table : array [1..8*48] of byte;π      server : array [1..8] of string;π       count : integer;π      count2 : integer;π           p : ^byte;π     no_more : integer;ππbeginπ  regs.ah := $EF;π  regs.al := $04;π  regs.ds := 0;π  regs.es := 0;π  msdos(regs);π  no_more := 0;π  p := ptr(regs.es, regs.si);π  move(p^,name_table,8*48);π  for count := 1 to 8 do server[count] := '';π  for count := 0 to 7 doπ  beginπ    no_more := 0;π    for count2 := (count*48)+1 to (count*48)+48 do if name_table[count2] <>π$00π        thenπ        beginπ        if no_more=0 then server[count+1] := server[count+1] +πchr(name_table[count2]);π        end else no_more:=1; {scan until 00h is found}π  end;π  if ((server_number<1) or (server_number>8)) then server_number := 1;π  server_name := server[server_number];πend;ππprocedure disable_file_server_login(var retcode : integer);πvar  request_buffer : recordπ      buffer_length : integer;π        subfunction : byteπ                end;ππ  reply_buffer : recordπ buffer_length : integer;π           end;ππbeginπ  With Regs Do Beginπ    Ah := $E3;π    Ds := Seg(Request_Buffer);π    Si := Ofs(Request_Buffer);π    Es := Seg(Reply_Buffer);π    Di := Ofs(Reply_Buffer);π  End;π  With request_buffer doπ   beginπ   buffer_length := 1;π   subfunction := $CB;π   end;π reply_buffer.buffer_length := 0;π msdos(regs);π retcode := regs.al;πend;ππprocedure enable_file_server_login(var retcode : integer);πvar request_buffer : recordπ     buffer_length : integer;π       subfunction : byteπ               end;ππ  reply_buffer : recordπ buffer_length : integer;π           end;ππbeginπ  With Regs Do Beginπ    Ah := $E3;π    Ds := Seg(Request_Buffer);π    Si := Ofs(Request_Buffer);π    Es := Seg(Reply_Buffer);π    Di := Ofs(Reply_Buffer);π  End;π  With request_buffer doπ   beginπ   buffer_length := 1;π   subfunction := $CC;π   end;π reply_buffer.buffer_length := 0;π msdos(regs);π retcode := regs.al;πend;πππprocedure get_directory_path(var handle : integer; var pathname : string; varπretcode : integer);πvar count : integer;ππ   request_buffer : recordπ              len : integer;π      subfunction : byte;π       dir_handle : byte;π              end;ππ     reply_buffer : recordπ              len : integer;π         path_len : byte;π        path_name : array [1..255] of byte;π              end;ππbeginπ  With Regs Do Beginπ    Ah := $e2;π    Ds := Seg(Request_Buffer);π    Si := Ofs(Request_Buffer);π    Es := Seg(Reply_Buffer);π    Di := Ofs(Reply_Buffer);π  End;π  With request_buffer doπ   beginπ   len := 2;π   subfunction := $01;π   dir_handle := handle;π   end;π  With reply_buffer doπ   beginπ   len := 256;π   path_len := 0;π   for count := 1 to 255 do path_name[count] := $00;π   end;π  msdos(regs);π  retcode := regs.al;π  pathname := '';π  if reply_buffer.path_len > 0 then for count := 1 to reply_buffer.path_len doπ     pathname := pathname + chr(reply_buffer.path_name[count]);πend;ππprocedure detach_from_file_server(var id,retcode:integer);πbeginπ regs.ah := $F1;π regs.al := $01;π regs.dl := id;π msdos(regs);π retcode := regs.al;πend;πππprocedure getstation( var _station: integer; var retcode: integer);πbeginπ   With Regs doπ   beginπ    ah := $DC;π    ds := 0;π    si := 0;π   end;π   MsDos( Regs );π   _station := Regs.al;π   retcode := 0;π   end;πππprocedure GetHexID( var userid,hexid: string; var retcode: integer);πvarπ    i,x           : integer;π    hex_id        : string;π    requestbuffer : recordπ      len      : integer;π      func     : byte;π      conntype : packed array [1..2] of byte;π      name_len : byte;π      name     : packed array [1..47] of char;π      end;π    replybuffer   : recordπ      len      : integer;π      uniqueid1: packed array [1..2] of byte;π      uniqueid2: packed array [1..2] of byte;π      conntype : word;π      name     : packed array [1..48] of byte;π      end;ππbeginπ  regs.ah := $E3;π  requestbuffer.func := $35;π  regs.ds := seg(requestbuffer);π  regs.si := ofs(requestbuffer);π  regs.es := seg(replybuffer);π  regs.di := ofs(replybuffer);π  requestbuffer.len := 52;π  replybuffer.len := 55;π  requestbuffer.name_len := length(userid);π  for i := 1 to length(userid) do requestbuffer.name[i] := userid[i];π  requestbuffer.conntype[2] := $1;π  requestbuffer.conntype[1] := $0;π  replybuffer.conntype := 1;π  msdos(regs);π  retcode := regs.al;   {π  if retcode = $96 then writeln('Server out of memory');π  if retcode = $EF then writeln('Invalid name');π  if retcode = $F0 then writeln('Wildcard not allowed');π  if retcode = $FC then writeln('No such object *',userid,'*');π  if retcode = $FE then writeln('Server bindery locked');π  if retcode = $FF then writeln('Bindery failure'); }π  hex_id := '';π  if retcode = 0 thenπ  beginπ   hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];π   hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];π   hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];π   hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];π   hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];π   hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];π   hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];π   hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];π   { Now we chop off leading zeros }π   while hex_id[1] = '0' do hex_id := copy(hex_id,2,length(hex_id));π  end;π   hexid := hex_id;πend;πππProcedure GetConnectionInfoπ(Var LogicalStationNo: Integer; Var Name: String; Var HEX_ID: String;π Var ConnType : Integer; Var DateTime : String; Var retcode:integer);ππVarπ  I,X            : Integer;π  RequestBuffer  : Recordπ                     PacketLength : Integer;π                     FunctionVal  : Byte;π                     ConnectionNo : Byte;π                   End;π  ReplyBuffer    : Recordπ                     ReturnLength : Integer;π                     UniqueID1    : Packed Array [1..2] of byte;π                     UniqueID2    : Packed Array [1..2] of byte;π                     NWConnType   : Packed Array [1..2] of byte;π                     ObjectName   : Packed Array [1..48] of Byte;π                     LoginTime    : Packed Array [1..8] of Byte;π                   End;π  Month          : String[3];π  Year,π  Day,π  Hour,π  Minute         : String[2];ππBeginπ  With RequestBuffer Do Beginπ    PacketLength := 2;π    FunctionVal := 22;  { 22 = Get Station Info }π    ConnectionNo := LogicalStationNo;π  End;π  ReplyBuffer.ReturnLength := 62;π  With Regs Do Beginπ    Ah := $e3;π    ds := 0;π    es := 0;π    Ds := Seg(RequestBuffer);π    Si := Ofs(RequestBuffer);π    Es := Seg(ReplyBuffer);π    Di := Ofs(ReplyBuffer);π  End;π  MsDos(Regs);π  retcode := regs.al;π  name := '';π  hex_id := hexdigits[replybuffer.uniqueid1[1] shr 4];π  hex_id := hex_id + hexdigits[replybuffer.uniqueid1[1] and $0F];π  hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] shr 4];π  hex_id := hex_id + hexdigits[replybuffer.uniqueid1[2] and $0F];π  hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] shr 4];π  hex_id := hex_id + hexdigits[replybuffer.uniqueid2[1] and $0F];π  hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] shr 4];π  hex_id := hex_id + hexdigits[replybuffer.uniqueid2[2] and $0F];π  { Now we chop off leading zeros }π    while ( (hex_id[1]='0') and (length(hex_id) > 1) )π             do hex_id := copy(hex_id,2,length(hex_id));π  ConnType := replybuffer.nwconntype[2];π  datetime := '';π  If hex_id <> '0' Then Begin {Grab username}π    With ReplyBuffer Do Beginπ      I := 1;π      While (I <= 48)  and (ObjectName[I] <> 0) Doπ        Beginπ        Name[I] := Chr(Objectname[I]);π        I := I + 1;π        End { while };π     Name[0] := Chr(I - 1);π   End; {With} End; {if}π   If hex_id <> '0' then With replybuffer do {Grab login time}π   beginπ     Str(LoginTime[1]:2,Year);π     Month := Months[LoginTime[2]];π     Str(LoginTime[3]:2,Day);π     Str(LoginTime[4]:2,Hour);π     Str(LoginTime[5]:2,Minute);π     If Day[1] = ' ' Then Day[1] := '0';π     If Hour[1] = ' ' Then Hour[1] := '0';π     If Minute[1] = ' ' Then Minute[1] := '0';π     DateTime := Day+'-'+Month+'-'+Year+' ' + Hour + ':' + Minute;π     End;πEnd { GetConnectInfo };ππprocedure login_to_file_server(obj_type:integer;_name,_password : string;varπretcode:integer);πvar   request_buffer : recordπ            B_length : integer;π         subfunction : byte;π              o_type : packed array [1..2] of byte;π         name_length : byte;π            obj_name : packed array [1..47] of byte;π     password_length : byte;π            password : packed array [1..27] of byte;π                 end;ππ        reply_buffer : recordπ            R_length : integer;π                 end;ππ               count : integer;ππbeginπWith request_buffer doπbeginπ B_length := 79;π subfunction := $14;π o_type[1] := 0;π o_type[2] := obj_type;π for count := 1 to 47 do obj_name[count] := $0;π for count := 1 to 27 do password[count] := $0;π if length(_name) > 0 thenπ    for count := 1 to length(_name) doπobj_name[count]:=ord(upcase(_name[count]));π if length(_password) > 0 thenπ    for count := 1 to length(_password) doπpassword[count]:=ord(upcase(_password[count]));π {set to full length of field}π name_length := 47;π password_length := 27;πend;πWith reply_buffer doπbeginπ R_length := 0;πend;π  With Regs Do Beginπ    Ah := $e3;π    Ds := Seg(Request_Buffer);π    Si := Ofs(Request_Buffer);π    Es := Seg(reply_buffer);π    Di := Ofs(reply_buffer);π  End;π  MsDos(Regs);π  retcode := regs.alπend;ππprocedure logout;π{logout from all file servers}πbeginπ regs.ah := $D7;π msdos(regs);πend;ππprocedure logout_from_file_server(var id: integer);π{logout from one file server}πbeginπ regs.ah := $F1;π regs.al := $02;π regs.dl := id;π msdos(regs);πend;πππππprocedure send_message_to_username(username,message : string; var retcode:πinteger);πVARπ   count1     : byte;π   userid     : string;π   stationid  : integer;π   ret_code   : integer;ππbeginπ   ret_code := 1;π   for count1:= 1 to length(username) doπ       username[count1]:=upcase(username[count1]); { Convert to upper case }π   getserverinfo;π   for count1:= 1 to serverinfo.connections_max doπ   beginπ     stationid := count1;π     getuser( stationid, userid, retcode);π      if userid = username thenπ        beginπ        ret_code := 0;π        send_message_to_station(stationid, message, retcode);π      end;π     end; { end of count }π     retcode := ret_code;π     { retcode = 0 if sent,  1 if userid not found }πend; { end of procedure }πππProcedure GetServerInfo;πVarπ  RequestBuffer  : Recordπ                     PacketLength : Integer;π                     FunctionVal  : Byte;π                   End;π  I              : Integer;ππBeginπ  With RequestBuffer Do Beginπ    PacketLength := 1;π    FunctionVal := 17;  { 17 = Get Server Info }π  End;π  ServerInfo.ReturnLength := 128;π  With Regs Do Beginπ    Ah := $e3;π    Ds := Seg(RequestBuffer);π    Si := Ofs(RequestBuffer);π    Es := Seg(ServerInfo);π    Di := Ofs(ServerInfo);π  End;π  MsDos(Regs);π  With serverinfo doπ  beginπ   connections_max := connectionmax[1]*256 + connectionmax[2];π   connections_in_use := connectionuse[1]*256 + connectionuse[2];π   max_connected_volumes := maxconvol[1]*256 + maxconvol[2];π   peak_connections_used := peak_used[1]*256 + peak_used[2];π   name := '';π   i := 1;π   while ((server[i] <> 0) and (i<>48)) doπ    beginπ    name := name + chr(server[i]);π    i := i + 1;π    end;π   end;πEnd;ππprocedure GetServerName(var servername : string; var retcode : integer);π{-----------------------------------------------------------------}π{ This routine returns the same as GetServerInfo.  This routine   }π{ was kept to maintain compatibility with the older  novell unit. }π{-----------------------------------------------------------------}πbeginπ  getserverinfo;π  servername := serverinfo.name;π  retcode := 0;π  end;ππprocedure send_message_to_station(station:integer; message : string; var retcode : integer);πVARπ   req_buffer : recordπ   buffer_len : integer;π   subfunction: byte;π      c_count : byte;π       c_list : byte;π   msg_length : byte;π          msg : packed array [1..55] of byte;π          end;ππ   rep_buffer : recordπ   buffer_len : integer;π      c_count : byte;π       r_list : byte;π          end;ππ   count1     : integer;ππbeginπ        if length(message) > 55 then message:=copy(message,1,55);π        With Regs doπ        beginπ         ah := $E1;π         ds:=seg(req_buffer);π         si:=ofs(req_buffer);π         es:=seg(rep_buffer);π         di:=ofs(rep_buffer);π        End;π        With req_buffer doπ        beginπ         buffer_len := 59;π         subfunction := 00;π         c_count := 1;π         c_list := station;π         for count1:= 1 to 55 do msg[count1]:= $00; { zero the buffer }π         msg_length := length(message); { message length }π         for count1:= 1 to length(message) doπmsg[count1]:=ord(message[count1]);π        End;π        With rep_buffer doπ        beginπ         buffer_len := 2;π         c_count := 1;π         r_list := 0;π        End;π        msdos( Regs );π        retcode:= rep_buffer.r_list;π   end;πππprocedure getuser( var _station: integer; var  _username: string; var retcode:πinteger);π{This procedure provides a shorter method of obtaining just the USERID.}πvarπ     gu_hexid : string;π  gu_conntype : integer;π  gu_datetime : string;ππbeginπ  getconnectioninfo(_station,_username,gu_hexid,gu_conntype,gu_datetime,retcode);πend;πππPROCEDURE GetNode( var hex_addr: string; var retcode: integer );π{ get the physical station address }ππConstπ   Hex_Set  :packed array[0..15] of char = '0123456789ABCDEF';ππBegin { GetNode }π   {Get the physical address from the Network Card}π   Regs.Ah := $EE;π   regs.ds := 0;π   regs.es := 0;π   MsDos(Regs);π   hex_addr := '';π   hex_addr := hex_addr + hex_set[(regs.ch shr 4)];π   hex_addr := hex_addr + hex_set[(regs.ch and $0f)];π   hex_addr := hex_addr + hex_set[(regs.cl shr 4) ];π   hex_addr := hex_addr + hex_set[(regs.cl and $0f)];π   hex_addr := hex_addr + hex_set[(regs.bh shr 4)];π   hex_addr := hex_addr + hex_set[(regs.bh and $0f)];π   hex_addr := hex_addr + hex_set[(regs.bl shr 4)];π   hex_addr := hex_addr + hex_set[(regs.bl and $0f)];π   hex_addr := hex_addr + hex_set[(regs.ah shr 4)];π   hex_addr := hex_addr + hex_set[(regs.ah and $0f)];π   hex_addr := hex_addr + hex_set[(regs.al shr 4)];π   hex_addr := hex_addr + hex_set[(regs.al and $0f)];π   retcode := 0;πEnd; { Getnode }πππPROCEDURE Get_Internet_Address(station : integer; var net_number, node_addr,πsocket_number : string; var retcode : integer);πππConstπ   Hex_Set  :packed array[0..15] of char = '0123456789ABCDEF';ππVar   Request_buffer : recordπ              length : integer;π         subfunction : byte;π          connection : byte;π                 end;ππ    Reply_Buffer : recordπ          length : integer;π         network : array [1..4] of byte;π            node : array [1..6] of byte;π          socket : array [1..2] of byte;π             end;ππ           count : integer;π      _node_addr : string;π  _socket_number : string;π     _net_number : string;ππbeginπ With Regs doπ beginπ  ah := $E3;π  ds:=seg(request_buffer);π  si:=ofs(request_buffer);π  es:=seg(reply_buffer);π  di:=ofs(reply_buffer);π End;π With request_buffer doπ beginπ  length := 2;π  subfunction := $13;π  connection := station;π end;π With reply_buffer doπ beginπ  length := 12;π  for count := 1 to 4 do network[count] := 0;π  for count := 1 to 6 do node[count] := 0;π  for count := 1 to 2 do socket[count] := 0;π end;π msdos(regs);π retcode := regs.al;π _net_number := '';π _node_addr := '';π _socket_number := '';π if retcode = 0 thenπ beginπ for count := 1 to 4 doπ     beginπ     _net_number := _net_number + hex_set[ (reply_buffer.network[count] shr 4)π];π     _net_number := _net_number + hex_set[ (reply_buffer.network[count] andπ$0F) ];π     end;π for count := 1 to 6 doπ     beginπ     _node_addr := _node_addr + (hex_set[ (reply_buffer.node[count] shr 4) ]);π     _node_addr := _node_addr + (hex_set[ (reply_buffer.node[count] and $0F)π]);π     end;π for count := 1 to 2 doπ     beginπ     _socket_number := _socket_number + (hex_set[ (reply_buffer.socket[count]πshr 4) ]);π     _socket_number := _socket_number + (hex_set[ (reply_buffer.socket[count]πand $0F) ]);π     end;π end; {end of retcode=0}π net_number := _net_number;π node_addr := _node_addr;π socket_number := _socket_number;π end;ππprocedure get_realname(var userid,realname:string; var retcode:integer);πvarπ    requestbuffer : recordπ    buffer_length : array [1..2] of byte;π      subfunction : byte;π      object_type : array [1..2] of byte;π    object_length : byte;π      object_name : array [1..47] of byte;π          segment : byte;π  property_length : byte;π    property_name : array [1..14] of byte;π    end;ππ      replybuffer : recordπ    buffer_length : array [1..2] of byte;π   property_value : array [1..128] of byte;π    more_segments : byte;π   property_flags : byte;π   end;ππ   count    : integer;π   id       : string;π   fullname : string;ππbeginπ  id := 'IDENTIFICATION';π  With requestbuffer do beginπ     buffer_length[2] := 0;π     buffer_length[1] := 69;π     subfunction  := $3d;π     object_type[1]:= 0;π     object_type[2]:= 01;π     segment := 1;π     object_length := 47;π     property_length := length(id);π     for count := 1 to 47 do object_name[count] := $0;π     for count := 1 to length(userid) do object_name[count] :=πord(userid[count]);π     for count := 1 to 14 do property_name[count] := $0;π     for count := 1 to length(id) do property_name[count] := ord(id[count]);π     end;π  With replybuffer do beginπ     buffer_length[1] := 130;π     buffer_length[2] := 0;π     for count := 1 to 128 do property_value[count] := $0;π     more_segments := 1;π     property_flags := 0;π     end;π  With Regs do beginπ     Ah := $e3;π     Ds := Seg(requestbuffer);π     Si := Ofs(requestbuffer);π     Es := Seg(replybuffer);π     Di := Ofs(replybuffer);π     end;π  MSDOS(Regs);π  retcode := Regs.al;π  fullname := '';π  count := 1;π  if replybuffer.property_value[1] <> 0 thenπ  repeatπ   beginπ   if replybuffer.property_value[count]<>0π      then fullname := fullname + chr(replybuffer.property_value[count]);π   count := count + 1;π   end;π   until ((count=128) or (replybuffer.property_value[count]=0));π  {if regs.al = $96 then writeln('server out of memory');π  if regs.al = $ec then writeln('no such segment');π  if regs.al = $f0 then writeln('wilcard not allowed');π  if regs.al = $f1 then writeln('invalid bindery security');π  if regs.al = $f9 then writeln('no property read priv');π  if regs.al = $fb then writeln('no such property');π  if regs.al = $fc then writeln('no such object');}π  if retcode=0 then realname := fullname else realname:='';πend;ππprocedure get_broadcast_mode(var bmode:integer);πbeginπ regs.ah := $de;π regs.dl := $04;π msdos(regs);π bmode := regs.al;πend;ππprocedure set_broadcast_mode(bmode:integer);πbeginπ if ((bmode > 3) or (bmode < 0)) then bmode := 0;π regs.ah := $de;π regs.dl := bmode;π msdos(regs);π bmode := regs.al;πend;ππprocedure get_broadcast_message(var bmessage: string; var retcode : integer);πvar requestbuffer : recordπ     bufferlength : array [1..2] of byte;π      subfunction : byte;π      end;ππ      replybuffer : recordπ     bufferlength : array [1..2] of byte;π    messagelength : byte;π          message : array [1..58] of byte;π          end;π    count : integer;ππbeginπ  With Requestbuffer do beginπ     bufferlength[1] := 1;π     bufferlength[2] := 0;π     subfunction := 1;π     end;π  With replybuffer do beginπ     bufferlength[1] := 59;π     bufferlength[2] := 0;π     messagelength := 0;π     end;π     for count := 1 to 58 do replybuffer.message[count] := $0;ππ  With Regs do beginπ     Ah := $e1;π     Ds := Seg(requestbuffer);π     Si := Ofs(requestbuffer);π     Es := Seg(replybuffer);π     Di := Ofs(replybuffer);π     end;π  MSDOS(Regs);π  retcode := Regs.al;π  bmessage := '';π  count := 0;π  if replybuffer.messagelength > 58 then replybuffer.messagelength := 58;π  if replybuffer.messagelength > 0 thenπ     for count := 1 to replybuffer.messagelength doπ     bmessage := bmessage + chr(replybuffer.message[count]);π  { retcode = 0 if no message,  1 if message was retreived }π  if length(bmessage) = 0 then retcode := 1 else retcode := 0;π  end;ππprocedure get_server_datetime(var _year,_month,_day,_hour,_min,_sec,_dow:integer);πvar replybuffer : recordπ           year : byte;π          month : byte;π            day : byte;π           hour : byte;π         minute : byte;π         second : byte;π            dow : byte;π            end;ππbeginπ  With Regs do beginπ     Ah := $e7;π     Ds := Seg(replybuffer);π     Dx := Ofs(replybuffer);π     end;π  MSDOS(Regs);π  retcode := Regs.al;π  _year := replybuffer.year;π  _month := replybuffer.month;π  _day := replybuffer.day;π  _hour := replybuffer.hour;π  _min := replybuffer.minute;π  _sec := replybuffer.second;π  _dow := replybuffer.dow;πend;ππprocedure set_date_from_server;πvar replybuffer : recordπ           year : byte;π          month : byte;π            day : byte;π           hour : byte;π         minute : byte;π         second : byte;π            dow : byte;π            end;ππbeginπ  With Regs do beginπ     Ah := $e7;π     Ds := Seg(replybuffer);π     Dx := Ofs(replybuffer);π     end;π  MSDOS(Regs);π  setdate(replybuffer.year+1900,replybuffer.month,replybuffer.day);πend;ππprocedure set_time_from_server;πvar replybuffer : recordπ           year : byte;π          month : byte;π            day : byte;π           hour : byte;π         minute : byte;π         second : byte;π            dow : byte;π            end;ππbeginπ  With Regs do beginπ     Ah := $e7;π     Ds := Seg(replybuffer);π     Dx := Ofs(replybuffer);π     end;π  MSDOS(Regs);π  settime(replybuffer.hour,replybuffer.minute,replybuffer.second,0);πend;ππprocedure get_server_version(var _version : string);πvar  count,x : integer;ππ       request_buffer : recordπ        buffer_length : integer;π          subfunction : byte;π          end;ππ         reply_buffer : recordπ        buffer_length : integer;π                stuff : array [1..512] of byte;π                end;ππ        strings : array [1..3] of string;πbeginπ  With Regs do beginπ     Ah := $e3;π     Ds := Seg(request_buffer);π     Si := Ofs(request_buffer);π     Es := Seg(reply_buffer);π     Di := Ofs(reply_buffer);π     end;π  With request_buffer doπ  beginπ     buffer_length := 1;π     subfunction := $c9;π  end;π  With reply_buffer doπ  beginπ     buffer_length := 512;π     for count := 1 to 512 do stuff[count] := $00;π  end;π  MSDOS(Regs);π  for count := 1 to 3 do strings[count] := '';π  x := 1;π  With reply_buffer doπ  beginπ    for count := 1 to 256 doπ    beginπ     if stuff[count] <> $0 thenπ        beginπ         if not ((stuff[count]=32) and (strings[x]='')) then strings[x] :=πstrings[x] + chr(stuff[count]);π        end;π     if stuff[count] = $0 then if x <> 3 then x := x + 1;π    end;π  End; { end of with }π  _version := strings[2];πend;ππprocedure open_message_pipe(var _connection, retcode : integer);πvar  request_buffer : recordπ      buffer_length : integer;π        subfunction : byte;π   connection_count : byte;π    connection_list : byte;π                end;ππ      reply_buffer : recordπ     buffer_length : integer;π  connection_count : byte;π       result_list : byte;π               end;πbeginπ  With Regs do beginπ     Ah := $e1;π     Ds := Seg(request_buffer);π     Si := Ofs(request_buffer);π     Es := Seg(reply_buffer);π     Di := Ofs(reply_buffer);π     end;π  With request_buffer doπ  beginπ     buffer_length := 3;π     subfunction := $06;π     connection_count := $01;π     connection_list := _connection;π  end;π  With reply_buffer doπ  beginπ     buffer_length := 2;π     connection_count := 0;π     result_list := 0;π  end;π  MSDOS(Regs);π  retcode := reply_buffer.result_list;πend;ππprocedure close_message_pipe(var _connection, retcode : integer);πvar  request_buffer : recordπ      buffer_length : integer;π        subfunction : byte;π   connection_count : byte;π    connection_list : byte;π                end;ππ      reply_buffer : recordπ     buffer_length : integer;π  connection_count : byte;π       result_list : byte;π               end;πbeginπ  With Regs do beginπ     Ah := $e1;π     Ds := Seg(request_buffer);π     Si := Ofs(request_buffer);π     Es := Seg(reply_buffer);π     Di := Ofs(reply_buffer);π     end;π  With request_buffer doπ  beginπ     buffer_length := 3;π     subfunction := $07;π     connection_count := $01;π     connection_list := _connection;π  end;π  With reply_buffer doπ  beginπ     buffer_length := 2;π     connection_count := 0;π     result_list := 0;π  end;π  MSDOS(Regs);π  retcode := reply_buffer.result_list;πend;ππprocedure check_message_pipe(var _connection, retcode : integer);πvar request_buffer : recordπ     buffer_length : integer;π       subfunction : byte;π  connection_count : byte;π   connection_list : byte;π               end;ππ      reply_buffer : recordπ     buffer_length : integer;π  connection_count : byte;π       result_list : byte;π               end;πbeginπ  With Regs do beginπ     Ah := $e1;π     Ds := Seg(request_buffer);π     Si := Ofs(request_buffer);π     Es := Seg(reply_buffer);π     Di := Ofs(reply_buffer);π     end;π  With request_buffer doπ  beginπ     buffer_length := 3;π     subfunction := $08;π     connection_count := $01;π     connection_list := _connection;π  end;π  With reply_buffer doπ  beginπ     buffer_length := 2;π     connection_count := 0;π     result_list := 0;π  end;π  MSDOS(Regs);π  retcode := reply_buffer.result_list;πend;πππprocedure send_personal_message(var _connection : integer; var _message :πstring; var retcode : integer);πvar count : integer;ππ      request_buffer : recordπ       buffer_length : integer;π         subfunction : byte;π    connection_count : byte;π     connection_list : byte;π      message_length : byte;π             message : array [1..126] of byte;π                 end;ππ        reply_buffer : recordπ       buffer_length : integer;π    connection_count : byte;π         result_list : byte;π                 end;ππbeginπ  With Regs do beginπ     Ah := $e1;π     Ds := Seg(request_buffer);π     Si := Ofs(request_buffer);π     Es := Seg(reply_buffer);π     Di := Ofs(reply_buffer);π     end;π  With request_buffer doπ  beginπ     subfunction := $04;π     connection_count := $01;π     connection_list := _connection;π     message_length := length(_message);π     buffer_length := length(_message) + 4;π     for count := 1 to 126 do message[count] := $00;π     if message_length > 0 then for count := 1 to message_length doπ        message[count] := ord(_message[count]);π  end;π  With reply_buffer doπ  beginπ     buffer_length := 2;π     connection_count := 0;π     result_list := 0;π  end;π  MSDOS(Regs);π  retcode := reply_buffer.result_list;πend;ππprocedure purge_erased_files(var retcode:integer);πvar  request_buffer : recordπ      buffer_length : integer;π        subfunction : byte;π                end;ππ       reply_buffer : recordπ      buffer_length : integer;π                end;πbeginπ  With request_buffer doπ    beginπ    buffer_length := 1;π    subfunction := $10;π    end;π  With reply_buffer do buffer_length := 0;π  With Regs do beginπ   Ah := $E2;π   Ds := Seg(request_buffer);π   Si := Ofs(request_buffer);π   Es := Seg(reply_buffer);π   Di := Ofs(reply_buffer);π   end;π  msdos(regs);π  retcode := regs.al;πend;ππprocedure purge_all_erased_files(var retcode:integer);πvar  request_buffer : recordπ      buffer_length : integer;π        subfunction : byte;π                end;ππ       reply_buffer : recordπ      buffer_length : integer;π                end;πbeginπ  With request_buffer doπ    beginπ    buffer_length := 1;π    subfunction := $CE;π    end;π  With reply_buffer do buffer_length := 0;π  With Regs do beginπ   Ah := $E3;π   Ds := Seg(request_buffer);π   Si := Ofs(request_buffer);π   Es := Seg(reply_buffer);π   Di := Ofs(reply_buffer);π   end;π  msdos(regs);π  retcode := regs.al;πend;πππprocedure get_personal_message(var _connection : integer; var _message :πstring; var retcode : integer);πvar count : integer;ππ      request_buffer : recordπ       buffer_length : integer;π         subfunction : byte;π                 end;ππ        reply_buffer : recordπ       buffer_length : integer;π   source_connection : byte;π      message_length : byte;π      message_buffer : array [1..126] of byte;π                 end;ππbeginπ    With Regs do beginπ     Ah := $e1;π     Ds := Seg(request_buffer);π     Si := Ofs(request_buffer);π     Es := Seg(reply_buffer);π     Di := Ofs(reply_buffer);π     end;π  With request_buffer doπ  beginπ     buffer_length := 1;π     subfunction := $05;π  end;π  With reply_buffer doπ  beginπ     buffer_length := 128;π     source_connection := 0;π     message_length := 0;π     for count := 1 to 126 do message_buffer[count] := $0;π  end;π  MSDOS(Regs);π  _connection := reply_buffer.source_connection;π  _message := '';π  retcode := reply_buffer.message_length;π  if retcode > 0 then for count := 1 to retcode doπ     _message := _message + chr(reply_buffer.message_buffer[count]);πend;ππprocedure log_file(lock_directive:integer; log_filename: string;πlog_timeout:integer; var retcode:integer);πbeginπ    With Regs do beginπ     Ah := $eb;π     Ds := Seg(log_filename);π     Dx := Ofs(log_filename);π     BP := log_timeout;π     end;πmsdos(regs);πretcode := regs.al;πend;ππprocedure release_file(log_filename: string; var retcode:integer);πbeginπ    With Regs do beginπ     Ah := $ec;π     Ds := Seg(log_filename);π     Dx := Ofs(log_filename);π     end;πmsdos(regs);πretcode := regs.al;πend;ππprocedure clear_file(log_filename: string; var retcode:integer);πbeginπ    With Regs do beginπ     Ah := $ed;π     Ds := Seg(log_filename);π     Dx := Ofs(log_filename);π     end;πmsdos(regs);πretcode := regs.al;πend;ππprocedure clear_file_set;πbeginπ regs.Ah := $cf;π msdos(regs);π retcode := regs.al;πend;ππprocedure lock_file_set(lock_timeout:integer; var retcode:integer);πbeginπ regs.ah := $CB;π regs.bp := lock_timeout;π msdos(regs);π retcode := regs.al;πend;ππprocedure release_file_set;πbeginπ regs.ah := $CD;π msdos(regs);πend;ππprocedure open_semaphore( _name:string;π                          _initial_value:shortint;π                          var _open_count:integer;π                          var _handle:longint;π                          var retcode:integer);πvar s_name : array [1..129] of byte;π    count : integer;π    semaphore_handle : array [1..2] of word;πbeginπ  if (_initial_value < 0) or (_initial_value > 127) then _initial_value := 0;π  for count := 1 to 129 do s_name[count] := $00; {zero buffer}π  if length(_name) > 127 then _name := copy(_name,1,127); {limit name length}π  if length(_name) > 0 then for count := 1 to length(_name) do s_name[count+1]π:= ord(_name[count]);π  s_name[1] := length(_name);π  regs.ah := $C5;π  regs.al := $00;π  move(_initial_value, regs.cl, 1);π  regs.ds := seg(s_name);π  regs.dx := ofs(s_name);π  regs.es := 0;π  msdos(regs);π  retcode := regs.al;π  if retcode = 0 then _open_count := regs.bl else _open_count := 0;π  semaphore_handle[1]:=regs.cx;π  semaphore_handle[2]:=regs.dx;π  move(semaphore_handle,_handle,4);πend;ππprocedure close_semaphore(var _handle:longint; var retcode:integer);πvar semaphore_handle : array [1..2] of word;πbeginπ move(_handle,semaphore_handle,4);π regs.ah := $C5;π regs.al := $04;π regs.ds := 0;π regs.es := 0;π regs.cx := semaphore_handle[1];π regs.dx := semaphore_handle[2];π msdos(regs);π retcode := regs.al;  { 00h=successful   FFh=Invalid handle}πend;ππprocedure examine_semaphore(var _handle:longint; var _value:shortint; varπ_count, retcode:integer);πvar semaphore_handle : array [1..2] of word;πbeginπ    move(_handle,semaphore_handle,4);π    regs.ah := $C5;π    regs.al := $01;π    regs.ds := 0;π    regs.es := 0;π    regs.cx := semaphore_handle[1];π    regs.dx := semaphore_handle[2];π    msdos(regs);π    retcode := regs.al; {00h=successful FFh=invalid handle}π    move(regs.cx, _value, 1);π    _count := regs.dl;πend;ππprocedure signal_semaphore(var _handle:longint; var retcode:integer);πvar semaphore_handle : array [1..2] of word;πbeginπ    move(_handle,semaphore_handle,4);π    regs.ah := $C5;π    regs.al := $03;π    regs.ds := 0;π    regs.es := 0;π    regs.cx := semaphore_handle[1];π    regs.dx := semaphore_handle[2];π    msdos(regs);π    retcode := regs.al;π    {00h=successful   01h=overflow value > 127   FFh=invalid handle}πend;ππprocedure wait_on_semaphore(var _handle:longint; _timeout:integer; varπretcode:integer);πvar semaphore_handle : array [1..2] of word;πbeginπ    move(_handle,semaphore_handle,4);π    regs.ah := $C5;π    regs.al := $02;π    regs.ds := 0;π    regs.es := 0;π    regs.bp := _timeout; {units in 1/18 of second,   0 = no wait}π    regs.cx := semaphore_handle[1];π    regs.dx := semaphore_handle[2];π    msdos(regs);π    retcode := regs.al;π    {00h=successful   FEh=timeout failure   FFh=invalid handle}πend;ππprocedure clear_connection(connection_number : integer; var retcode :πinteger);πvar con_num : byte;ππ    request_buffer : recordπ            length : integer;π       subfunction : byte;π           con_num : byte;π               end;ππ      reply_buffer : recordπ            length : integer;π               end;ππbeginπ  with request_buffer do beginπ     length := 4;π     con_num := connection_number;π     subfunction := $D2;π     end;π  reply_buffer.length := 0;π  with regs do beginπ     Ah := $e3;π     Ds := Seg(request_buffer);π     Si := Ofs(request_buffer);π     Es := Seg(reply_buffer);π     Di := Ofs(reply_buffer);π     end;π  msdos(regs);π  retcode := regs.al;πend;πππprocedure get_server_lan_driver_information(var _lan_board_number : integer;π{ This will return info on what }           var _text1,_text2:string;π{ type of network cards are being }         var _network_address : byte4;π{ used in the server. }                     var _host_address : byte6;π                                            var _driver_installed,π                                                _option_number,π                                                _retcode : integer);ππvar      count : integer;π          text : array [1..3] of string;π            x1 : integer;ππ         request_buffer : recordπ                 length : integer;π            subfunction : byte;π              lan_board : byte;π                     end;ππ           reply_buffer : recordπ                 length : integer;π        network_address : byte4;π           host_address : byte6;π   lan_driver_installed : byte;π          option_number : byte;π     configuration_text : array [1..160] of byte;π                     end;πbeginπ with request_buffer do beginπ      length := 2;π      subfunction := $E3;π      lan_board := _lan_board_number; { 0 to 3 }π      end;π with reply_buffer do beginπ      length := 174;π      for count := 1 to 4 do network_address[count] := $0;π      for count := 1 to 6 do host_address[count] := $0;π      lan_driver_installed := 0;π      option_number := 0;π      for count := 1 to 160 do configuration_text[count] := $0;π      end;π  with regs do beginπ     Ah := $E3;π     Ds := Seg(request_buffer);π     Si := Ofs(request_buffer);π     Es := Seg(reply_buffer);π     Di := Ofs(reply_buffer);π     end;π  msdos(regs);π  retcode := regs.al;π  _text1 := '';π  _text2 := '';π  if retcode <> 0 then exit;π  _driver_installed := reply_buffer.lan_driver_installed;π  if reply_buffer.lan_driver_installed = 0 then exit;π  {-- set some values ---}π  for count := 1 to 3 do text[count] := '';π  x1 := 1;π    with reply_buffer do beginπ      _network_address := network_address;π      _host_address := host_address;π      _option_number := option_number;π      for count := 1 to 160 doπ      beginπ      if ((configuration_text[count] = 0) and (x1 <> 3)) then x1 := x1+1;π      if configuration_text[count] <> 0 thenπ         text[x1] := text[x1] + chr(configuration_text[count]);π      end;π    end;π  _text1 := text[1];π  _text2 := text[2];πend;ππend. { end of unit novell }π  3      05-26-9411:03ALL                      R. GILOMEN               Novell IPX functions     SWAG9405            398    ,î   UNIT IPX;π(****************************************************************************)π(*                                                                          *)π(*  PROJEKT        : PASCAL Treiber fuer Novell-NetWare                     *)π(*  MODULE         : IPX.PAS                                                *)π(*  VERSION        : 1.10C                                                  *)π(*  COMPILER       : Turbo Pascal V 6.0                                     *)π(*  DATUM          : 13.06.91                                               *)π(*  AUTOR          : R. Gilomen                                             *)π(*  GEPRUEFT       : R. Gilomen                                             *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG   : Bibliothek mit den IPX-Grunfunktionen. Dieses Modul    *)π(*                   wurde mit IPX Version 2.12 getestet.                   *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  MODIFIKATIONEN :                                                        *)π(*                                                                          *)π(*  Version  1.00A      20.02.91  R. Gilomen    Initial Version             *)π(*  Version  1.10A      28.02.91  R. Gilomen    Neue Funktionen             *)π(*                                              IPX_To_Addr                 *)π(*                                              IPX_From_Addr               *)π(*                                              IPX_Internetwork_Address    *)π(*  Version  1.10B      07.03.91 R. Gilomen     Fehler in Funktion IPX_Done *)π(*                                              behoben. Bei SEND wurde     *)π(*                                              Source.Socket veraendert.   *)π(*  Version  1.10C      13.06.91 R. Gilomen     Defaultwert fuer Parameter  *)π(*                                              STAY_OPEN auf $FF gesetzt.  *)π(*                                                                          *)π(****************************************************************************)πππ(*//////////////////////////////////////////////////////////////////////////*)π                                   INTERFACEπ(*//////////////////////////////////////////////////////////////////////////*)πππ(*==========================================================================*)π(*                         DEKLARATIONEN / DEFINITIONEN                     *)π(*==========================================================================*)ππCONSTππ(* Allgemeine Deklarationen *)ππ         MAX_SOCKETS          = 20;    (* Maximale Anzahl konfigurierte     *)π                                       (* Kommunikationssockel.             *)π         MAX_DATA_SIZE        = 546;   (* Maximale Datenlaenge              *)π         NET_LENGTH           = 4;     (* Laenge Netzwerkadresse            *)π         NODE_LENGTH          = 6;     (* Laenge Knotenadresse              *)π   ππ(* Code Deklarationen *)ππ         SEND                  = $10;π         RECEIVE               = $20;πππ(* Deklaration der Rueckgabewerte *)ππ         SUCCESS               = $00;π         NOT_ENDED             = $10;π         PARAMETER_ERROR       = $20;π         NO_DESTINATION        = $21;π         DEVICE_SW_ERROR       = $30;π         SOCKET_TABLE_FULL     = $31;π         PACKET_BAD            = $32;π         PACKET_UNDELIVERIABLE = $33;π         PACKET_OVERFLOW       = $34;π         DEVICE_HW_ERROR       = $40;πππTYPE   S4Byte          =  ARRAY [1..4]  OF BYTE; (* Datentyp fuer Network   *)π       S6Byte          =  ARRAY [1..6]  OF BYTE; (* Datentyp fuer Node      *)ππ                                                 (* Datentyp fuer Daten     *)π       Data_Packet     = ARRAY [1..MAX_DATA_SIZE] OF CHAR;ππ       SData           = RECORD                  (* Daten und Laenge        *)π                           Data   : Data_Packet;π                           Length : WORD;π                          END;ππ       Network_Address = RECORD                  (* Datentyp fuer NW-Adr.   *)π                           Network     : S4Byte;π                           Node        : S6Byte;π                           Socket      : WORD;π                         END;πππ(*==========================================================================*)π(*                         PROZEDUREN / FUNKTIONEN                          *)π(*==========================================================================*)πππFUNCTION IPX_Setup : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG : Die Routine initialisiert die IPX-Software und deren     *)π(*                 Funktion.                                                *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : -                                                  *)π(*                                                                          *)π(*                  OUT: Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Open_Socket ( VAR Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Routine eroeffnet einen Kommunikationssockel.       *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Nummer des Sockels, der eroeffnet  *)π(*                                       werden soll.                       *)π(*                                                                          *)π(*                  OUT: Socket        = Nummer des Sockels, der effektiv   *)π(*                                       geoeffnet wurde.                   *)π(*                                                                          *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Close_Socket ( Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Routine schliesst einen Kommunikationssockel.       *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Nummer des Sockels, der geschlos-  *)π(*                                       sen werden soll.                   *)π(*                                                                          *)π(*                  OUT: Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Send ( Socket    : WORD;π                    Dest_Addr : Network_Address;π                    Buffer    : SDataπ                  ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Routine dient zum senden von Daten an eine oder     *)π(*                  mehrere Gegenstationen.                                 *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Sockelnummer, auf der gesendet     *)π(*                                       werden soll.                       *)π(*                       Dest_Addr     = Vollstaendige Netwerkadresse der   *)π(*                                       Gegenstation(en).                  *)π(*                       Buffer        = Daten die gesendet werden und      *)π(*                                       dessen Laenge.                     *)π(*                                                                          *)π(*                  OUT: Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Receive ( Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Routine dient zum Empfangen von Daten einer Gegen-  *)π(*                  station. Die Daten koennen, wenn das Kommando beendet   *)π(*                  ist, mit der Funktion IPX_Done vom Netzwerk abgeholt    *)π(*                  werden.                                                 *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Sockelnummer, auf der empfangen    *)π(*                                       werden soll.                       *)π(*                                                                          *)π(*                  OUT: Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Done ( Socket          : WORD;π                    Code            : BYTE;π                    VAR Source_Addr : Network_Address;π                    VAR Buffer      : SDataπ                  ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Funktion liefert den Status einer vorher abgesetz-  *)π(*                  ten Routine. Zurueckgegeben wird, ob die Routine schon  *)π(*                  beendet ist oder nicht sowie eventuelle Daten.          *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Sockelnummer, auf der die Funktion *)π(*                                       ausgefuehrt werden soll.           *)π(*                       Code          = Routine, deren Status ueberprueft  *)π(*                                       werden soll.                       *)π(*                                                                          *)π(*                  OUT: Source_Addr   = Vollstaendige Netzwerkadresse der  *)π(*                                       Gegenstation, von der Daten einge- *)π(*                                       troffen sind.                      *)π(*                       Buffer        = Buffer, in dem eventuelle Daten    *)π(*                                       abgelegt werden koennen.           *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_Internetwork_Address ( VAR Network : S4Byte;π                                    VAR Node    : S6Byteπ                                  ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Funktion liefert die Internetzwerkadresse der       *)π(*                  jeweiligen Station.                                     *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  OUT: Network       = Netzwerkadresse                    *)π(*                       Node          = Knotenadresse                      *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_To_Addr ( Network     : String;π                       Node        : String;π                       Socket      : String;π                       VAR Addr    : Network_Addressπ                     ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG : Die Routine konvertiert die Eingabestrings in die Daten- *)π(*                 struktur Network_Address.                                *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Network       = Netzwerkadresse die konvertiert    *)π(*                                       werden soll.                       *)π(*                       Node          = Knotenadresse die konvertiert      *)π(*                                       werden soll.                       *)π(*                       Socket        = Sockelnummer die konvertiert       *)π(*                                       werden soll.                       *)π(*                                                                          *)π(*                  OUT: Addr          = Konvertierte vollsaendige Netz-    *)π(*                                       werkadresse.                       *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππππFUNCTION IPX_From_Addr ( Addr            : Network_Address;π                         VAR Network     : String;π                         VAR Node        : String;π                         VAR Socket      : Stringπ                       ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG : Die Routine konvertiert die vollstaendige Netzwerk-      *)π(*                 adresse in String's.                                     *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Addr          = Vollstaendige Netzwerkadresse      *)π(*                                                                          *)π(*                  OUT: Network       = Netzwerkadresse die konvertiert    *)π(*                                       wurde.                             *)π(*                       Node          = Knotenadresse die konvertiert      *)π(*                                       wurde.                             *)π(*                       Socket        = Sockelnummer die konvertiert       *)π(*                                       wurde.                             *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)πππππ(*//////////////////////////////////////////////////////////////////////////*)π                                 IMPLEMENTATIONπ(*//////////////////////////////////////////////////////////////////////////*)πππ(*==========================================================================*)π(*                                UNITS IMPORT                              *)π(*==========================================================================*)ππUSES     Dos;ππ(*==========================================================================*)π(*                         DEKLARATIONEN / DEFINITIONEN                     *)π(*==========================================================================*)πππCONSTππ(* Allgemeine Definitionen *)ππ         HEADER       = 30;            (* Groesse IPX-Header                *)π         PACKET_SIZE  = 576;           (* IPX-Paket groesse                 *)πππ(* Definitionen der IPX-Funktionen *)ππ         IPX_TST      = $7A00;         (* Vorbereiten fuer IPX Test         *)π         MUX_INTR     = $2F;           (* Multiplex Interrupt               *)π         OPEN_SOCKET  = $0000;         (* Oeffnet einen Sockel              *)π         CLOSE_SOCKET = $0001;         (* Schliesst einen Sockel            *)π         GET_TARGET   = $0002;         (* Pruefe Gegenstation               *)π         DO_SEND      = $0003;         (* Sendet ein Paket                  *)π         DO_RECEIVE   = $0004;         (* Empfaengt Pakete                  *)π         GET_ADDR     = $0009;         (* Bestimmt Internetzwerkadresse     *)πππ(* Definitionen der IPX-Parameter *)ππ         STAY_OPEN    = $FF;           (* $00 : Sockel bleibt geoeffnet,    *)π                                       (* bis er explizit geschlossen wird  *)π                                       (* oder das Programm terminiert.     *)π                                       (* $FF : Sockel bleibt geoeffnet,    *)π                                       (* bis er explizit geschlossen wird. *)π                                       (* Wird benoetigt fuer TSR-Programme.*)ππ(* Definitionen der IPX-Rueckgabewerte *)ππ         IPX_LOADED   = $FF;           (* IPX ist geladen                   *)π         OPENED       = $00;           (* Sockel erfolgreich geoeffnet      *)π         ALREADY_OPEN = $FF;           (* Sockel ist bereits goeffnet       *)π         TABLE_FULL   = $FE;           (* Sockel Tabelle ist voll           *)π         EXIST        = $00;           (* Weg zu Gegenstation existiert     *)π         NO_SOCKET    = $FF;           (* Sockel existiert nicht            *)π         SEND_OK      = $00;           (* Senden war erfolgreich            *)π         SOCKET_ERROR = $FC;           (* Sockel existiert nicht mehr       *)π         SIZE_ERROR   = $FD;           (* Paketgroesse nicht korrekt        *)π         UNDELIV      = $FE;           (* Paket nicht ausgeliefert          *)π         OVERFLOW     = $FD;           (* Buffer zu klein                   *)π         HW_ERROR     = $FF;           (* Hardware defekt                   *)π         REC_OK       = $00;           (* Paket erfolgreich empfangen       *)πππ(* Definition der ECB-Parameter *)ππ         FINISHED     = $00;           (* Routine beendet                   *)π         FRAG_COUNT   = 1;             (* Anzahl Fragmente                  *)π         UNKNOWN      = 0;             (* Unbekannter Paket Typ             *)ππ(* Deklarationen *)ππTYPE     S12Byte      = ARRAY [1..12] OF BYTE;   (* Interner Datentyp       *)ππ         IPX_Packet   = RECORD         (* IPX-Paket Struktur                *)π                          CheckSum         : WORD;π                          Length           : WORD;π                          TransportControl : BYTE;π                          PacketType       : BYTE;π                          Destination      : Network_Address;π                          Source           : Network_Address;π                          IPX_Data         : Data_Packet;π                        END;ππ         ECB_Fragment = RECORD         (* Fragment der ECB Struktur         *)π                          Address : ^IPX_Packet;π                          Size    : WORD;π                        END;ππ         ECB = RECORD                  (* ECB Datenstruktur                 *)π                Link_Adress        : S4Byte;π                ESR_Address        : ^BYTE;π                InUseFlag          : BYTE;π                CompletionCode     : BYTE;π                SocketNumber       : WORD;π                IPX_Workspace      : S4Byte;π                DriverWorkspace    : S12Byte;π                ImmediateAddress   : S6Byte;π                FragmentCount      : WORD;π                FragDescr          : ECB_Fragment;π               END;πππ         Int_Addr = RECORD             (* Datenstruktur Internetzwerkadr.   *)π                      Network : S4Byte;π                      Node    : S6Byte;π                    END;πππVAR      IPX_Location : ARRAY [1..2] OF WORD;    (* Adresse von IPX         *)ππ                                                 (* Array in dem die ECB's  *)π                                                 (* verwaltet werden.       *)π         ECB_Table    : ARRAY [1..MAX_SOCKETS] OF ^ECB;πππ(*==========================================================================*)π(*                         PROZEDUREN / FUNKTIONEN                          *)π(*==========================================================================*)πππPROCEDURE IPX_Call ( VAR Regs : Registers );π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Diese Prozedur setzt die in Regs spezifizierten         *)π(*                  Register des Prozessors. Anschliessend wird ein IPX-    *)π(*                  Call ausgefuehrt und die Register wieder ausgelesen.    *)π(*                  Es werden nicht alle Register der Datenstruktur         *)π(*                  Regs uebernommen!                                       *)π(*                                                                          *)π(*  PARAMETER    :  IN : Regs          = Register, die gesetzt werden       *)π(*                                       sollen.                            *)π(*                                                                          *)π(*                  OUT: Regs          = Register, die vom IPX gesetzt      *)π(*                                       wurden (Return values).            *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      Temp_AX, Temp_BX, Temp_CX, Temp_DX,π         Temp_ES, Temp_SI, Temp_DI               : WORD;ππBEGINπ Temp_AX := Regs.AX;π Temp_BX := Regs.BX;π Temp_CX := Regs.CX;π Temp_DX := Regs.DX;π Temp_SI := Regs.SI;π Temp_ES := Regs.ES;π Temp_DI := Regs.DI;π ASMπ  PUSH BP                              (* Register sichern                  *)π  PUSH SPπ  PUSH SSπ  PUSH DSπ  PUSH AXπ  PUSH BXπ  PUSH CXπ  PUSH DXπ  PUSH SIπ  PUSH ESπ  PUSH DIπ  MOV AX, Temp_AX                      (* Register setzen                   *)π  MOV BX, Temp_BXπ  MOV CX, Temp_CXπ  MOV DX, Temp_DXπ  MOV SI, Temp_SIπ  MOV ES, Temp_ESπ  MOV DI, Temp_DIπ  CALL DWORD PTR IPX_Location          (* IPX aufrufen                      *)π  MOV Temp_AX, AX                      (* Register auslesen                 *)π  MOV Temp_BX, BXπ  MOV Temp_CX, CXπ  MOV Temp_DX, DXπ  MOV Temp_SI, SIπ  MOV Temp_ES, ESπ  MOV Temp_DI, DIπ  POP DIπ  POP ES                               (* Gesicherte Register wieder        *)π  POP SI                               (* zuruecksetzen.                    *)π  POP DXπ  POP CXπ  POP BXπ  POP AXπ  POP DS                               π  POP SS                               π  POP SPπ  POP BPπ END;ππ Regs.AX := Temp_AX;π Regs.BX := Temp_BX;π Regs.CX := Temp_CX;π Regs.DX := Temp_DX;π Regs.SI := Temp_SI;π Regs.ES := Temp_ES;π Regs.DI := Temp_DI;πEND;ππππFUNCTION IPX_Setup : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG : Die Routine initialisiert die IPX-Software und deren     *)π(*                 Funktion.                                                *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : -                                                  *)π(*                                                                          *)π(*                  OUT: Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      i        : INTEGER;           (* Laufvariable                      *)π         Temp_Reg : Registers;         (* Temporaere Register fuer Int.     *)πππBEGINπ  Temp_Reg.AX := IPX_TST;              (* Test ob IPX geladen.              *)π  Intr (MUX_INTR,Temp_Reg);π  IF (Temp_Reg.AL <> IPX_LOADED) THENπ  BEGINπ    IPX_Setup := DEVICE_SW_ERROR;      (* IPX nicht geladen                 *)π    EXIT;π  END;π  Temp_Reg.AX := Temp_Reg.ES;π  IPX_Location[1] := Temp_Reg.DI;      (* Adresse von IPX sichern           *)π  IPX_Location[2] := Temp_Reg.AX;ππ  FOR i := 1 TO MAX_SOCKETS DO         (* Array fuer ECB init.              *)π    ECB_Table[i] := NIL;ππ  IPX_Setup := SUCCESS;                (* Initialisierung erfolgreich       *)πEND;ππππFUNCTION IPX_Open_Socket ( VAR Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Routine eroeffnet einen Kommunikationssockel.       *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Nummer des Sockels, der eroeffnet  *)π(*                                       werden soll.                       *)π(*                                                                          *)π(*                  OUT: Socket        = Nummer des Sockels, der effektiv   *)π(*                                       geoeffnet wurde.                   *)π(*                                                                          *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      i        : INTEGER;           (* Laufvariable                      *)π         Index    : INTEGER;           (* Index auf ECB_Table               *)ππ         Temp_Reg : Registers;         (* Temporaere Register fuer IPX-Call *)πππBEGINπ  Socket := Swap(Socket);              (* In Motorola Format konvertieren   *)ππ  FOR i := 1 TO MAX_SOCKETS DO         (* Pruefen, ob Sockel existiert      *)π    IF ECB_Table[i] <> NIL THENπ      IF Socket = ECB_Table[i]^.SocketNumber THENπ      BEGINπ        IPX_Open_Socket := PARAMETER_ERROR;π        EXIT;π      END;ππ  Index := 1;π  WHILE (ECB_Table[Index] <> NIL) DO   (* Pruefen, ob alle Sockel belegt    *)π  BEGIN                                (* falls es noch freie ECB hat,      *)π    IF Index >= MAX_SOCKETS THEN       (* steht Index auf einem solchen.    *)π    BEGINπ      IPX_Open_Socket := SOCKET_TABLE_FULL;π      EXIT;π    END;π    Index := Index + 1;π  END;ππ  Temp_Reg.BX := OPEN_SOCKET;          (* Register fuer Call vorbereiten    *)π  Temp_Reg.AL := STAY_OPEN;π  Temp_Reg.DX := Socket;ππ  IPX_Call (Temp_Reg);ππ  Socket := Temp_Reg.DX;               (* Register auslesen                 *)ππ  IF Temp_Reg.AL <> OPENED THEN        (* IPX nicht i.O.                    *)π  BEGINπ    IPX_Open_Socket := DEVICE_SW_ERROR;π    EXIT;π  END;ππ  NEW (ECB_Table[Index]);              (* Vollstaendiger ECB erzeugen       *)π  NEW (ECB_Table[Index]^.FragDescr.Address);π  ECB_Table[Index]^.SocketNumber := Socket;ππ  Socket := Swap(Socket);              (* Zurueck in INTEL Format konv.     *)π  IPX_Open_Socket := SUCCESS;ππEND;ππππFUNCTION IPX_Close_Socket ( Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Routine schliesset einen Kommunikationssockel.      *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Nummer des Sockels, der geschlos-  *)π(*                                       sen werden soll.                   *)π(*                                                                          *)π(*                  OUT: Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      Index    : INTEGER;           (* Index auf ECB_Table               *)ππ         Temp_Reg : Registers;         (* Temporaere Register fuer IPX-Call *)πππBEGINπ  Socket := Swap(Socket);              (* In Motorola Format konvertieren   *)ππ  Index := 1;                          (* Sockel suchen                     *)π  WHILE (ECB_Table[Index]^.SocketNumber <> Socket) DOπ  BEGIN                               π    IF Index >= MAX_SOCKETS THENπ    BEGINπ      IPX_Close_Socket := PARAMETER_ERROR;       (* Sockel existiert nicht  *)π      EXIT;π    END;π    Index := Index + 1;π  END;ππ  Temp_Reg.BX := CLOSE_SOCKET;         (* Register fuer Call vorbereiten    *)π  Temp_Reg.DX := Socket;ππ  IPX_Call (Temp_Reg);ππ                                       (* Allozierter Speicher freigeben    *)π  DISPOSE (ECB_Table[Index]^.FragDescr.Address);π  ECB_Table[Index]^.FragDescr.Address := NIL;π  DISPOSE (ECB_Table[Index]);π  ECB_Table[Index] := NIL;π ππ  IPX_Close_Socket := SUCCESS;ππEND;ππππFUNCTION IPX_Send ( Socket    : WORD;π                    Dest_Addr : Network_Address;π                    Buffer    : SDataπ                  ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Routine dient zum senden von Daten an eine oder     *)π(*                  mehrere Gegenstation(en).                               *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Sockelnummer, auf der gesendet     *)π(*                                       werden soll.                       *)π(*                       Dest_Addr     = Vollstaendige Netwerkadresse der   *)π(*                                       Gegenstation(en).                  *)π(*                       Buffer        = Daten die gesendet werden und      *)π(*                                       dessen Laenge.                     *)π(*                                                                          *)π(*                  OUT: Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      i         : INTEGER;          (* Laufvariable                      *)π         Index     : INTEGER;          (* Index auf ECB_Table               *)ππ         Temp_Reg  : Registers;        (* Temporaere Register fuer IPX-Call *)ππ         Temp_Imm_Addr : S6Byte;       (* Temporaere ImmdediateAddress      *)ππ         Temp_Addr : S12Byte;          (* Temporaere Internetworkadresse    *)πππBEGINπ  Socket := Swap(Socket);              (* In Motorola Format konvertieren   *)π  Dest_Addr.Socket := Swap(Dest_Addr.Socket);ππ  Index := 1;                          (* Sockel suchen                     *)π  WHILE (ECB_Table[Index]^.SocketNumber <> Socket) DOπ  BEGINπ    IF Index >= MAX_SOCKETS THENπ    BEGINπ      IPX_Send := PARAMETER_ERROR;     (* Sockel existiert nicht            *)π      EXIT;π    END;π    Index := Index + 1;π  END;ππ  IF Buffer.Length > MAX_DATA_SIZE THEN     (* Laenge der Daten pruefen     *)π  BEGINπ    IPX_Send := PARAMETER_ERROR;π    EXIT;π  END;ππ  WITH Dest_Addr DO                    (* Pruefe ob Gegenstation erreichbar *)π  BEGINπ    FOR i := 1 TO NET_LENGTH DO        (* Internetzwerkadresse zusammenst.  *)π      Temp_Addr[i] := Network[i];π    FOR i := 1 TO NODE_LENGTH DOπ      Temp_Addr[i + NET_LENGTH] := Node[i];π    Temp_Addr[11] := Lo(Socket);       (* Low-Byte                          *)π    Temp_Addr[12] := HI(Socket);       (* High-Byte                         *)π  END;ππ  Temp_Reg.ES := Seg(Temp_Addr);       (* Register fuer Call vorbereiten    *)π  Temp_Reg.SI := Ofs(Temp_Addr);ππ  Temp_Reg.DI := Ofs(Temp_Imm_Addr);π  Temp_Reg.BX := GET_TARGET;ππ  IPX_Call (Temp_Reg);ππ  ECB_Table[Index]^.ImmediateAddress := Temp_Imm_Addr;ππ  IF Temp_Reg.AL <> EXIST THENπ  BEGINπ    IPX_Send := NO_DESTINATION;        (* Weg nicht verfuegbar              *)π    EXIT;π  END;ππ  WITH ECB_Table[Index]^ DO            (* ECB mit Parametern fuellen        *)π  BEGINπ    ESR_Address := NIL;π    SocketNumber := Socket;π    InUseFlag := FINISHED;π    FragmentCount := FRAG_COUNT;π    WITH FragDescr.Address^ DO         (* IPX-Header vorbereiten            *)π    BEGINπ      PacketType := UNKNOWN;π      WITH Destination DOπ      BEGINπ        Network := Dest_Addr.Network;π        Node := Dest_Addr.Node;π        Socket := Dest_Addr.Socket;π      END;π      IPX_Data := Buffer.Data;π    END;π    FragDescr.Size := Buffer.Length + 30;π  END;ππ  Temp_Reg.ES := Seg(ECB_Table[Index]^);  (* Register fuer Call vorbereiten *)π  Temp_Reg.SI := Ofs(ECB_Table[Index]^);π  Temp_Reg.BX := DO_SEND;ππ  IPX_Call (Temp_Reg);ππ  IPX_Send := SUCCESS;ππEND;ππππFUNCTION IPX_Receive ( Socket : WORD ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Routine dient zum Empfangen von Daten einer Gegen-  *)π(*                  station. Die Daten koennen, wenn das Kommando beendet   *)π(*                  ist, mit der Funktion IPX_Done vom Netzwerk abgeholt    *)π(*                  werden.                                                 *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Sockelnummer, auf der empfangen    *)π(*                                       werden soll.                       *)π(*                                                                          *)π(*                  OUT: Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      Index     : INTEGER;          (* Index auf ECB                     *)π         i         : INTEGER;          (* Laufvariable                      *)ππ         Temp_Reg  : Registers;        (* Temporaere Register fuer IPX-Call *)πππBEGINπ  Socket := Swap(Socket);              (* In Motorola Format konvertieren   *)ππ  Index := 1;                          (* Sockel suchen                     *)π  WHILE (ECB_Table[Index]^.SocketNumber <> Socket) DOπ  BEGINπ    IF Index >= MAX_SOCKETS THENπ    BEGINπ      IPX_Receive := PARAMETER_ERROR;  (* Sockel existiert nicht            *)π      EXIT;π    END;π    Index := Index + 1;π  END;ππ  WITH ECB_Table[Index]^ DO            (* ECB mit Parametern fuellen        *)π  BEGINπ    ESR_Address := NIL;π    FragmentCount := FRAG_COUNT;π    FragDescr.Size := PACKET_SIZE;π    InUseFlag := FINISHED;π  END;ππ  Temp_Reg.ES := Seg(ECB_Table[Index]^);    (* Register vorbereiten         *)π  Temp_Reg.SI := Ofs(ECB_Table[Index]^);π  Temp_Reg.BX := DO_RECEIVE;ππ  IPX_Call (Temp_Reg);ππ  IF Temp_Reg.AL = NO_SOCKET THENπ  BEGINπ    IPX_Receive := DEVICE_SW_ERROR;π    EXIT;π  END;ππ  IPX_Receive := SUCCESS;ππEND;πππππFUNCTION IPX_Done ( Socket          : WORD;π                    Code            : BYTE;π                    VAR Source_Addr : Network_Address;π                    VAR Buffer      : SDataπ                  ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Funktion liefert den Status einer vorher abgesetz-  *)π(*                  ten Routine. Zurueckgegeben wird, ob die Routine schon  *)π(*                  beendet ist oder nicht sowie eventuelle Daten.          *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Socket        = Sockelnummer, auf der die Funktion *)π(*                                       ausgefuehrt werden soll.           *)π(*                       Code          = Routine, deren Status ueberprueft  *)π(*                                       werden soll.                       *)π(*                                                                          *)π(*                  OUT: Source_Addr   = Vollstaendige Netzwerkadresse der  *)π(*                                       Gegenstation, von der Daten einge- *)π(*                                       troffen sind.                      *)π(*                       Buffer        = Buffer, in dem eventuelle Daten    *)π(*                                       abgelegt werden koennen.           *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      i         : INTEGER;          (* Laufvariable                      *)π         Index     : INTEGER;          (* Index auf ECB_Table               *)ππ         Temp_Reg  : Registers;        (* Temporaere Register fuer IPX-Call *)πππBEGINπ  Socket := Swap(Socket);              (* In Motorola Format konvertieren   *)ππ  Index := 1;                          (* Sockel suchen                     *)π  WHILE (ECB_Table[Index]^.SocketNumber <> Socket) DOπ  BEGINπ    IF Index >= MAX_SOCKETS THENπ    BEGINπ      IPX_Done := PARAMETER_ERROR;     (* Sockel existiert nicht            *)π      EXIT;π    END;π    Index := Index + 1;π  END;π                                       (* Test ob Funktion beendet          *)π  IF ECB_Table[Index]^.InUseFlag <> FINISHED THENπ  BEGINπ     IPX_Done := NOT_ENDED;π     EXIT;π  END;ππ  CASE Code OFπ    SEND :π    BEGIN                              (* Send Completion Code auswerten    *)π      CASE ECB_Table[Index]^.CompletionCode OFπ        SEND_OK      : ;π        SOCKET_ERROR : BEGINπ                         IPX_Done := DEVICE_SW_ERROR;π                         EXIT;π                       END;π        SIZE_ERROR   : BEGINπ                         IPX_Done := PACKET_BAD;π                         EXIT;π                       END;π        UNDELIV      : BEGINπ                         IPX_Done := PACKET_UNDELIVERIABLE;π                         EXIT;π                       END;π        HW_ERROR     : BEGINπ                         IPX_Done := DEVICE_HW_ERROR;π                         EXIT;π                       ENDπ        ELSE           BEGINπ                         IPX_Done := DEVICE_SW_ERROR;π                         EXIT;π                       END;π      END;π    END;π    RECEIVE :π    BEGIN                             (* Receive Completion Code auswerten  *)π      CASE ECB_Table[Index]^.CompletionCode OFπ        REC_OK : BEGIN                 (* Daten in Benutzerbuffer kopieren  *)π                   WITH ECB_Table[Index]^.FragDescr DOπ                   BEGINπ                     Buffer.Data := Address^.IPX_Data;π                     Buffer.Length := Swap(Address^.Length) - HEADER;π                   END;π                                       (* Netzwerkadresse umkopieren        *)π                   WITH ECB_Table[Index]^.FragDescr.Address^.Source DOπ                   BEGINπ                     Source_Addr.Network := Network;π                     Source_Addr.Node := Node;π                     Source_Addr.Socket := Swap(Socket);π                   END;π                 END;π        SOCKET_ERROR : BEGINπ                         IPX_Done := DEVICE_SW_ERROR;π                         EXIT;π                       END;π        OVERFLOW     : BEGINπ                         IPX_Done := PACKET_OVERFLOW;π                         EXIT;π                       END;π        NO_SOCKET    : BEGINπ                         IPX_Done := DEVICE_SW_ERROR;π                         EXIT;π                       ENDπ        ELSE           BEGINπ                         IPX_Done := DEVICE_SW_ERROR;π                         EXIT;π                       END;π      END;π    ENDπ    ELSE  BEGINπ            IPX_Done := PARAMETER_ERROR;π          EXIT;π    END;ππ  END;ππ  IPX_Done := SUCCESS;ππEND;ππππFUNCTION IPX_Internetwork_Address ( VAR Network : S4Byte;π                                    VAR Node    : S6Byteπ                                  ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG :  Die Funktion liefert die Internetzwerkadresse der       *)π(*                  jeweiligen Station.                                     *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  OUT: Network       = Netzwerkadresse                    *)π(*                       Node          = Knotenadresse                      *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      Temp_Reg     : Registers;     (* Temporaere Register fuer IPX-Call *)ππ         Reply_Buffer : Int_Addr;      (* Temporaerer Buffer fuer Adressen  *)ππBEGINππ  Temp_Reg.ES := Seg(Reply_Buffer);    (* Register vorbereiten              *)π  Temp_Reg.SI := Ofs(Reply_Buffer);π  Temp_Reg.BX := GET_ADDR;ππ  IPX_Call (Temp_Reg);ππ  Network := Reply_Buffer.Network;     (* Daten umkopieren                  *)π  Node := Reply_Buffer.Node;ππ  IPX_Internetwork_Address := SUCCESS;ππEND;ππππFUNCTION IPX_To_Addr ( Network     : String;π                       Node        : String;π                       Socket      : String;π                       VAR Addr    : Network_Addressπ                     ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG : Die Routine konvertiert die Eingabestrings in die Daten- *)π(*                 struktur Network_Address.                                *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Network       = Netzwerkadresse die konvertiert    *)π(*                                       werden soll.                       *)π(*                       Node          = Knotenadresse die konvertiert      *)π(*                                       werden soll.                       *)π(*                       Socket        = Sockelnummer die konvertiert       *)π(*                                       werden soll.                       *)π(*                                                                          *)π(*                  OUT: Addr          = Konvertierte vollsaendige Netz-    *)π(*                                       werkadresse.                       *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      i,n,Code  : INTEGER;π         c         : CHAR;π         Temp      : BYTE;ππBEGINππ  (* Pruefe Netzwerk und Node Laenge *)π  IF (ORD(Network[0]) <> (2 * NET_LENGTH)) ORπ     (ORD(Node[0]) <> (2 * NODE_LENGTH)) THENπ  BEGINπ    IPX_To_Addr := PARAMETER_ERROR;π    EXIT;π  END;ππ  (* Netzwerkadresse konvertieren *)π  i := 1;π  n := 1;π  WHILE ( i <= (2 * NET_LENGTH)) DOπ  BEGINπ    c := UPCASE(Network[i]);π    CASE c OFπ      'A'..'F': Addr.Network[n] := ORD(c) - 55;π      '0'..'9': Addr.Network[n] := ORD(c) - 48π    ELSE        BEGINπ                  IPX_To_Addr := PARAMETER_ERROR;π                  EXIT;π                END;π    END;π    Addr.Network[n] := Addr.Network[n] SHL 4;π    c := UPCASE(Network[i + 1]);π    CASE c OFπ      'A'..'F': Temp := ORD(c) - 55;π      '0'..'9': Temp := ORD(c) - 48;π    ELSE        BEGINπ                  IPX_To_Addr := PARAMETER_ERROR;π                  EXIT;π                END;π    END;π    Addr.Network[n] := Addr.Network[n] + Temp;π    i := i + 2;π    n := n + 1;π  END;πππ  (* Node-Adresse konvertieren *)π  i := 1;π  n := 1;π  WHILE ( i <= (2 * NODE_LENGTH)) DOπ  BEGINπ    c := UPCASE(Node[i]);π    CASE c OFπ      'A'..'F': Addr.Node[n] := ORD(c) - 55;π      '0'..'9': Addr.Node[n] := ORD(c) - 48;π    ELSE        BEGINπ                  IPX_To_Addr := PARAMETER_ERROR;π                  EXIT;π                END;π    END;π    Addr.Node[n] := Addr.Node[n] SHL 4;π    c := UPCASE(Node[i + 1]);π    CASE c OFπ      'A'..'F': Temp := ORD(c) - 55;π      '0'..'9': Temp := ORD(c) - 48;π    ELSE        BEGINπ                  IPX_To_Addr := PARAMETER_ERROR;π                  EXIT;π                END;π    END;π    Addr.Node[n] := Addr.Node[n] + Temp;π    i := i + 2;π    n := n + 1;π  END;ππ  (* Sockelnummer konvertieren *)π  VAL (Socket,Addr.Socket,Code);π  IF Code <> 0 THENπ  BEGINπ    IPX_To_Addr := PARAMETER_ERROR;π    EXIT;π  END;ππ  IPX_To_Addr := SUCCESS;ππEND;ππππFUNCTION IPX_From_Addr ( Addr            : Network_Address;π                         VAR Network     : String;π                         VAR Node        : String;π                         VAR Socket      : Stringπ                       ) : BYTE;π(*--------------------------------------------------------------------------*)π(*                                                                          *)π(*  BESCHREIBUNG : Die Routine konvertiert die vollstaendige Netzwerk-      *)π(*                 adresse in String's.                                     *)π(*                                                                          *)π(*                                                                          *)π(*  PARAMETER    :  IN : Addr          = Vollstaendige Netzwerkadresse      *)π(*                                                                          *)π(*                  OUT: Network       = Netzwerkadresse die konvertiert    *)π(*                                       wurde.                             *)π(*                       Node          = Knotenadresse die konvertiert      *)π(*                                       wurde.                             *)π(*                       Socket        = Sockelnummer die konvertiert       *)π(*                                       wurde.                             *)π(*                       Rueckgabewert = Fehlercode                         *)π(*                                                                          *)π(*--------------------------------------------------------------------------*)ππVAR      i,n,Code      : INTEGER;π         c             : CHAR;π         TempHi,TempLo : BYTE;ππBEGINππ  (* Netzwerkadresse konvertieren *)π  i := 1;π  n := 1;π  WHILE ( i <= (2 * NET_LENGTH)) DOπ  BEGINπ    TempHi := Addr.Network[n] DIV 16;  (* Hi-Nibble                         *)π    CASE TempHi OFπ      10..15  : Network[i] := CHR(TempHi + 55);π      0..9    : Network[i] := CHR(TempHi + 48)π    ELSE        BEGINπ                  IPX_From_Addr := PARAMETER_ERROR;π                  EXIT;π                END;π    END;π    i := i + 1;π    TempLo := Addr.Network[n] MOD 16;  (* Lo-Nibble                         *)π    CASE TempLo OFπ      10..15  : Network[i] := CHR(TempLo + 55);π      0..9    : Network[i] := CHR(TempLo + 48)π    ELSE        BEGINπ                  IPX_From_Addr := PARAMETER_ERROR;π                  EXIT;π                END;π    END;π    i := i + 1;π    n := n + 1;π  END;π  Network[0] := CHR(i);               (* Laenge Netzwerkadresse fuer String *)πππ  (* Node-Adresse konvertieren *)π  i := 1;π  n := 1;π  WHILE ( i <= (2 * NODE_LENGTH)) DOπ  BEGINπ    TempHi := Addr.Node[n] DIV 16;     (* Hi-Nibble                         *)π    CASE TempHi OFπ      10..15  : Node[i] := CHR(TempHi + 55);π      0..9    : Node[i] := CHR(TempHi + 48)π    ELSE        BEGINπ                  IPX_From_Addr := PARAMETER_ERROR;π                  EXIT;π                END;π    END;π    i := i + 1;π    TempLo := Addr.Node[n] MOD 16;     (* Lo-Nibble                         *)π    CASE TempLo OFπ      10..15  : Node[i] := CHR(TempLo + 55);π      0..9    : Node[i] := CHR(TempLo + 48)π    ELSE        BEGINπ                  IPX_From_Addr := PARAMETER_ERROR;π                  EXIT;π                END;π    END;π    i := i + 1;π    n := n + 1;π  END;π  Node[0] := CHR(i - 1);              (* Laenge Knotenadr. fuer String     *)πππ  (* Sockelnummer konvertieren *)π  STR (Addr.Socket,Socket);ππ  IPX_From_Addr := SUCCESS;πEND;ππEND.